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EEE XXX = XXX CCC HHH HHH NNN NNN GGG a] 
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EEEECEEEEEEE XXX ccc HHHHHHHHHHHHHHH NNN NNN NNN GGG 4 
EEE XXX XXX ccc HHH HHH NNN NNNNNN GGG  GGGGGGGGG a] 
EEE XXX = XXX ccc HH HHH NNN NNNNNN GGG G6GGGGGGGG a 
EEE XXX = XXX CCC HHH HHH NNN NNNNNN GGG 6GGGGGGGGG " 
EEE XXX XXX CCC HHH HHH NNN NNN GGG GGG 0 
EEE XXX XXX CCC HHH HHH NNN NNN 6GG GGG 0 
EEE XXX XXX CCC Hi HHH NNN NNN GGG GGG 0 
EEE NNN GGGGGGGGS P 
FEE NNN GGGGGGG4G P| 
EEE NNN GGGGGGGGG . 
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wine exch$library (IDENT = 'V04-000') = &TITLE ‘Facility-wide Library module’ 
' 


leuaeeeeeeneneenenceeanertenerneceneteeereeteneseesnetterenseneennetteetenens 


is COPYRIGHT (c) 1978, 1980, 1982, 1984 
ie DIGITAL EQUIPMENT CORPORATION, MAYNARD. MASSACHUSETTS. 
'® ALL RIGHTS RESERVED. 


® 
® 
® 
& 
® 
if THIS SOFTWARE. IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED + 
is ONLY IN, ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE 
i INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER 
is COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY 
is OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE TS HERESY 
ie TRANSFERRED . 
4 ® 
is THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE  * 
i AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT * 
i CORPORATION. ‘ 

® 

® 

® 

® 

® 

® 


ITY FOR THE USE OR RELIABILITY OF ITS 


:* DIGITAL ASSUMES NO RESPONSIBILIT 
IS NOT SUPPLIED BY DIGITAL. 


I 
!# SOFTWARE ON EQUIPMENT WHICH 


SRR REAR AAA AEA 


Add NOREMOTE, NOTSAMEDEV * RT11_DIRSIZE message codes. 


"Faciuity: EXCHANGE = Foreign volume interchange facility 

ABSTRACT: BLISS Library for EXCHANGE facility 

ENVIRONMENT: VAX/VMS User mode 

AUTHOR: Cw Hobbs . CREATION DATE: 1-July-1982 

MODIFIED BY: 

V03-002 CWH3002 CW Hobbs 12-Apr-1984 
i 

a 
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: Include files: 


LIBRARY files: 


LIBRARY 
*SYSSLIBRARY:L1B° ! VMS operating system Library 


REQUIRE files: 


REQU 
‘ies: :EXCDEFS' ! include the SDL definitions 


Macros: 


Declare some macros as shorthand for the psect names 
MACRO 


1$-}ep-}984 99:55:17 


BS CEXCHNG. she EXCL1I8.B32; °° 


Sglobal_rw = PSECT GLOBAL = exch$rw_global (ADDRESSING_MODE (LONG_RELATIVE)); 
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Declare some common data structure initialization macros 


Define shorthand for a single initialized dynamic string desc 


$dyn_str_desc ! Static declaration 
BLOCK Cdsc$k_d_bin, BYTE) 
PRESET (Cds baclass] = dsc$k_class_d, 
dsc$b_dtype = dsc$k_dtype_t, 
dsc$w_length] = 0, 
: dsc$a_pointer] = 0 ) 
Sdyn_str_desc_init (desci) ! Run-time initialization 
BEGIN 
BIND 
desc = i) : VECTOR C2, LONG], 
tagl = $gg_dyn_str_template : VECTOR (2, LONG]; 
desc ; = L fod: 
desc (1) = t Cid; 
END 


Define macro for a single initialized static string desc. 


$stat_str_desc (L, A) 


! Static declaration 


class = dsc$k_class_s, 
type] = qocSk ctype t, 
= (A)’) 


$stat_str_desc_init (desci, L, A) ! Run-time initialization 


BEGIN 
BIN 


D 
desc = (desci) : 
desc sets tue 
d 
d 


desc 
desc 
desc 
END 
i, 


$str_desc_set (desci, L. A) 
BEGIN 
BIND 


desc = (desci) : BLOCK 
desc Cdsc$w_length] = te 
rj = : 


sc$b_dtype 
sc$w_length] 
sc$a_pointer]) 


L . BYTE); 
lass_s; 


C 
kc 
k_dtype_t; 


nnnn@ 
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! Copy new Length and pointer fields (both static and dynamic) 


C, BYTE); 


desc Cdsc$a_pointer] 
END 
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32 v4.0 
EX - 


7 one Pa 4 
3 CHNG.SRCJEXCLIB.B32;1 (3), 


; } And shorthand for just a descriptor declaration 
" : $desc_block Y 
M rh na Cdsc$k_s_bln, BYTE] 
ei Short form for byte vector reference 
" es $Sref_bvector : 
M 1765 REF $bvector 
28 x, 
Short form for byte block reference 
- $ref_bblock ‘ 
" = $bblock 
STRUCTURE 


$bvector CI; NI tn) 
($bvector+1)<0,8,0>; 
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+ 

! SIGNAL_STOP a condition assuming no return. LIBS$exch_signal_STOP is not 
! supposed to return, but BLISS doesn't know this, so we block further 

i flow here. This will generate better code for us. 


ae 
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CRO 
$exch_signal_stop (J 


SHS 


BEGIN 
LINKAGE 
LNK = CALL : PRESERVE (0,1,2,3,4,5,6,7,8,9,10,11); 
EXTERNAL ROUTINE 
jester : ADDRESSING_MODE (GENERAL) LNK NOVALUE; 


SEENLS 


VL SS 


ree PERE SE EE EE EF | 
ee ee a ee ee ee ee ee a ee ee a ee ee a a a dd 


BUILTI 
; ; 
96 LIBSSTOP (ZREMAINING) ; | 
‘ ° Py | 
ty RETURN (.RO) 

99 END | 
ae. | 
it SIGNAL a condition and return. | 
805 CRO 

_ 308 $Sexch_signal_return (code) | 
M 308 BEGIN 
™ 1809 LOCAL 


—T A AMON S BO KOR TOMMOOWZ SF KOCK ITO MWMMOOWOZ™T SE KCK TOM OOOZ Sr ACK TO MMIC 
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: i i i? temp; 

741 \ tem eee ); } peed he ere multiple calls, etc 

; 4 181 $1G AL .tem erform the actual aignet of the error 
; 6 1814 tt LENGTH GTR i ESHER m OREMATNING 4FI 

3; 4 1815 0 RETURN .temp 

; 4 1816 0 

; M 1817 8 END 

>: ©1818 x; 

>; 1819 0 

: 1820 0 + 

3 1821 0 i SIGNAL a condition and continue. 

; 18s¢ 0 ie 

3 1825 0 ACRO 

>; 1824 0 $exch_signal (code) 

; 4 1825 0 = 

3; ™ 1826 0 SIGNAL ( (code) ' Perform the actual pignal of the error 
3; 6 1827 O ZIF ZLENGTH GTR i STHEN »SREMAINING ZF I 

$ 1828 0 3 

3 1829 0 


EEE ee 
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>; 1330 6 ‘+ 
; i : 2 Initialize a control block type and size fields. We do not depend on them being in the standard positions 
oo 38 : 6 MACRO 
:; 1834 0 $Sblock_init (addr, prefix) 
; 4 1835 0 = 
>; M 1836 0 BEGIN 
; 4 1837 0 BIND 
; 4 1838 O addr2 = (addr) : BLOCK C, BYTE); 
; 4 1839 0 aes XNAME (prefix,'Sw_size')] = XNAME (‘exchblk$s_'. prefix); 
; § 1840 0 addr2 CXZNAME (prefix,'S$b_type’)] = XNAME (‘exchblk$k_‘, prefix); 
; 4 1841 0 END 
3 186 0 %; 
; 18435 @ 
: 1844 0 1+ 
; 1362 ° Check a control block type and size fields. Note that we depend on them being in the standard positions 
; 1847 0 MACRO 
3 . Ht 8 $Sblock_check (level, addr, prefix, error_code) 
: 4 1850 0 Z1F switch variant GEQ (level) 
; 4 1851 O XTHEN 
; M 1836 0 BEGIN 
; 4 1853 0 EXTERNAL ROUTINE : 
; 132 exch$util_block check : jsb_rOrir2 NOVALUE; 
; 4 1856 0 exch$util_block_ check ( (addr), (error_code), - 
: . 1930 . (XNAME ("exchblk$s_' prefix) “16 OR ZNAME (‘exchblk$k_*,prefix))); 
; 4 1859 0 END 
; 4 1860 0 2F I 
: 1861 0 H 
3 1308 0 
; 61863 0 MACRO 
; " 1366 8 $block_check_if_nonzero (level, addr, prefix, error_code) 
; M 1866 0 ZIF switch_variant GEQ (level) 
3; M 1867 3 XTHEN 
: M 1868 BEGIN 
3; 4 1869 0 BIND 
; 4 1870 0 addr2 = (addr) : BLOCK C, BYTE); 
; 4 1871 QO IF addr2 NEQ 0 
ae | 1376 0 HEN 
3; 187 8 $block_check ((level), (addr), prefix, (error_code)); 
3; M 1874 END 
: & 1875 0 ZF I 
:; 1876 0 q; 
s rr @ 
; 1878 0 + . 
: Hs 14 ! : Check for a logic error. If the expression is not true, then we have a problem. 
; 1881 0 MACRO 
; 1886 0 $logic_check (level, condition, error_code) 
3; M 1883 0 = 
; M 1884 3 . = : : 
3; M 1885 ' See if a compile time check is possible 
; M 1886 0 : 
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: M 1887 ZIF 2CTCE (( condition) ) 

1 a 

; ! Th ition is a compile-time expression. There is one special case, when the 
: iBo8 : soagit lon ia eae string “false” This is used as an unconditional logic abort. 
: 1830 0 i If we have “(false)”, then do a naked SIGNAL_STOP 

: mM 1892 0 RIF RIDENTICAL (condition, (false)) 

: 1836 3 SIGNAL_STOP (exch$_badlogic, 1, (error_code)) 

: m 1898 0 : The condition is a normal test. If it is true, print a message that the condition 
> 4 1899 0 was verified during compilation. If false, generate a serious error. 

741 ! 

; M 1901 0 ZELSE 

; M 1308 8 ZIF (condition) 

: M 1908 0 ee rr (‘assumption ‘',error_code,' verified during compilation’) 

; L 

: i" 1908 ZERROR (‘assumption ‘,error_code,’ is not true’) 

; 4 1907 0 xF I 

; M Hb 4F I 

: m 1910 0 : The condition is not a compile-time constant. If the current variant calls for it, 
+4 1911 0 ! generate run-time code to test the assumption. 

PR 191s 6 YELSE 

761914 0 ZIF switch variant GEQ (Level) 

mist 0 ATHEN BEGIN 

im 19? 0 IF NOT (condition) 

: x 1319 SIGNAL_STOP (exch$_badlogic, 1, (error_code)); 

; 4 1920 0 END 

>; 4 1921 QO XF I 

; M1922 0 2F I 

; 1925 @ ; 


—_———S— 


IWWAWIWGPrororofrer 


WN" OODONOUS 


WDOOWOOODOODOODODOOOOOOODOODOD0D000 


~ 


SEES ZRRRRARRLLE LS 
PARAM MNAAA ANA eee + pat yy 
WN OOCONAUESWN —OODNOULSWN—OOONOU 


cee ee PY 
abmbabebababaoiaiuaiaicabuiabaabeabubabeiebwiabwiwMabauiuiebabababababMabababaiahababuababah aaah al at ahah aes 


Ez 
felelelelelelelelele lel ele elelololel olan alata) alaleloleolelalelololololololelolelololelelelelolololololololololo) 


SSS 


BEBBBEBIzzZ 
gSSSSS24S3$ 
SOONAULSWN—OOON 


16 
16-Sep-1984 00:35:17  VAK=11_ Bliss-32 v4.0-74 p 8 
1-00-19 1 ei atS | “SSsSSpBAsaStexchne sacSexcie.e32:1°°% «58 


+ 

Most messages are defined as warnings so that we can signal without changing flow of execution. Several 
macros are defined in EXCLIB to change the severity code. These are $warning_stat, $success_stat, 
$Serror_stat, Sinfo_stat and Ssevere_stat. A typical use would be: 


status = Lib$foo (bar); 
IF NOT .status 
THEN 


BEGIN 

$Swarning_stat (status); ' Convert unknown severity to warning 
SIGNAL (.status); 

RETURN .status; 

END; 


These macros modify the status variable and return the value of the modified status. 


! For those situations where it is inappropriate to modify the code, forms of the macro are available which 
modify copies of the status code. These macro names have ‘'_copy'’ appended to the modify form of the macro 
name. A couple of examples of their use are: 


status = Lib$foo (bar); status = Lib$foo (bar); 
IF NOT .status IF NOT .status 
THEN THEN 
BEGIN BEGIN 
new stat = Swarning_status_copy (.status); SIGNAL ($error_status_copy (exch$_badfoo), 0, .status); 
SIGNAL (.new_stat); RETURN (exch$_Badfoo); 
Abe (.status); END; 


' 
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Note that the ‘“‘_copy’’ forms have value arguments, the regular forms have address arguments. 


Convert status codes to specific status values. 


MACRO 
Sinhibit_msg (status) 
BEGIN 
BIND 
status2 = status : BLOCK (4, BYTE); iy. P 
status2 Csts$v_inhib_msg] = 1; ! Inhibit SEXIT signzlling 
setatued ! Value of block is new code 


Sinhibit_msg_copy (status) 


Status2 : BLOCK (4, BYTE); 
stewung $9.0 32,0) = status; 
status2 [sts$v_inhib_msg] = 1; 
.status 
END 


Copy the whole code _— 
Inhibit SEXIT signalling 
Value of block is new code 


° 


$Swarning_stat (status) 
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BEGIN 
BIND 
stgtuse = status : guock (4, BYTE); 
status2 [sts$v_severity] = sts$k_ warning; 
peratund ! 


Swarning_stat_copy (status) 


BEGIN 
LOCAL 
status2 : BLOCK (4, BYTE]; 


ecaeuas $0.0 32,0] = status; - 
status sts$v_severity] = sts$k_warning; 
getetes 


$success_stat (status) 


BEGIN 
BIND 

status2 = status : BLOCK (4, BYTE); 
status2 (sts$v_severity] = sts$k_success; 
getetus : 


$success_stat_copy (status) 


status2 : BLOCK (4, BYTE); 
status2 [0,0,32,0] = status; 
status2 Csts$v_severity] = sts$k_success; 
getotues 


$error_stat (status) 


BEGIN 
BIND 

status2 = status : BLOCK (4, BYTE]; 
status2 ([sts$v_severity] = sts$k_error; ! 
gorotune 


$Serror_stat_copy (status) 


Statuse : BLOCK (4, BYTE]; 
status2 (0,0,32,0] = status; 


17 
13 


Value 


Value 


Force 


' Value 
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! Force status to warning 
of block is new code 


! Copy the whole code — 
' Force status to warning 
! Value of block is new code 


: Force status to success 
of block is new code 


! Copy the whole code 
! Force status to success 
' Value of block is new code 


status to error 
of block is new code 


! Copy the whole code 
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Stetuse Letedy_sever tty. = sts$k_error; 


.Status 
ND 
Sinfo_stat (status) 
BEGIN 
BIND me 
s 

status? t 
.Status2 
END 


Sinfo_stat_copy (status) 


s2=s 
sts$v_ 


tatus : BLOCK (4, BYTE); 
severity] = sts$k_info; 


status2 : BLOCK (4, BYTE); 


peeeueg ‘ 
status 
.status2 
END 


$severe_stat (status) 


0,0,32 
sts$v_ 


.0] = status; 
severity] = sts$k_info; 


status2 = status : BLOCK (4, BYTE]; 


status2 [ 
-Status2 
END 


$severe_stat_copy (status) 


status2 [ 
statuse [ 
.Status2 
END 


Special debug and trace macros 


MACRO 
$dbgtrc_prefix (string) 


sts$v_severity] = sts$k_severe; t 
! Value of block is new code 


sts$v_ 


L 
status2 : BLOCK (4, BYTE]; 
0.0,32,0 


.0] = status; 
severity] = sts$k_severe; 


5 
4: 
' 
' 
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! Force status to error 
' Value of block is new code 


13 $25 


! Force status to info 
' Value of block is new code 


Copy the whole code 
Force status to info 


' Value of block is new code 


! Force status to severe 


' Copy the whole code 
! Force status to severe 
' Value of block is new code 


! Declare a nested macro with the value of the string 


MACRO $dbgtrc_prefix_string = string ZQUOTE 2% 


$check_call (level, routine_addr) 


' Call the routine depending on variant level 


we 


~oO 
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= 
aH switch variant GEQ (level) 
HEN - 


BEGIN 
EXTERNAL ROUTINE routine _addr : ADDRESSING_MODE (GENERAL); 
fos ne, peer (ZREMAININGY 
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Message print routines 


MACRO 
Sprint_lit (string) 
‘ 


LibSput output {ZASCID string) 


$trace_print_lit (string) 
ZIF switch _trace 
ZTHEN 


Lib$Sput_output (ZASCID ZSTRING (S$dbgtrc_prefix_string, string)) 
ZFI ! switch trace 


$debug_print_lit (string) 


ZIF switch debug 
Z THEN 


Lib$put_ output (ZASCID ZSTRING (S$dbgtrc_prefix_string, string)) 
tI ! switch debug msi 9 9 


B2Bzzz 
MPININININININIDS 2 OO OS OS OO 


$Sprint_desc (desc) 


LibSput_output (desc) 


$trace_print_desc (desc) 


WAN 


LIF switch_trace 
%THEN 


BEGIN 

EXTERNAL ROUTINE exch$util_fao_buffer; 

LibSput_output ( : 
exch$util_fao_buffer (ZASCID %STRING (S$dbgtrc_prefix_string, "!AS"), desc)) 


END 
v! ! switch_trace 


PORGRoRoRoRoRORoROROROROROTURORURONORONOROROPU RG ROTO ROROnoRUnonononononononononononononorononororonoronononononuny 


$debug_print_desc (desc) 
ZIF switch_debug 
THEN 
BEGIN } 
EXTERNAL ROUTINE exch$util_fao_buffer; 
LibSput_output ( ; , 
exch$util_fao_buffer (ZASCID 2STRING (Sdbgtrc_prefix_string, "!AS*), desc)); 


END 
he ! switch_debug 


$print_fao (string) 


RS ee ee ee ee ee ee ee ee ee 


rFaealtaltalealtslesltaleal of ot at at ot at ot ot ot lie) OOo. 


fele le le lelelele olen lolol eleolealeolealolaloleleleoleololelaoleolelelelolelealelololelelolololelolelolololelololol ololol a) 


BEGIN 
EXTERNAL ROUTINE exch$util_fao_buffer; 


BSBSESBESZITZ BSBBSSISZITSZ 
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Lib$put gutout ( 
exch$util_fao_buffer (ZASCID gtr ing 
— ZIF SCENGTH GTR 1 ZTHEN ,ZREMAINING %F1)) 
i, 
$trace_print_fao (string) 
IF switch _trace 
ZTHEN 
BEGIN 
EXTERNAL ROUTINE exch$util_fao_buffer; 
LibSput_out 


- Z1F ZCENGTH GTR 1 XTHEN , REMAINING 
oF ; eolech Spent 


$debug_print_fao (string) 
XIF switch debug 
XTHEN 


BEGIN 
EXTERNAL ROUTINE exch$util_fao_buffer; 
Lib$put_output 


CEXCHNG. SRC JEXCLIB.B32;1 


ut 
exchsut it fao_buffer (ZASCID ZSTRING Codparce aretin string. string) 


exch$util_fao_buffer (ZASCID ZSTRING CSébgtre_pretin_string. string) 


aaa ZIF ZCENGTH GTR 1 XTHEN ,%REMAINING % 
te ! switch debug 
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38 Macros to manipulate queues 
oe MACRO 
3 Initialize the header of a queue. This means make each of the 2 pointers in the header point to the header. 
. 98 $Squeue_initialize (q_header) 
: BEGIN 
i, BIND 
e -ah_ = (q_header) : VECTOR (2, LONGI; 
" ah FS}: -$hei 
M END 


Insert an element at the head of a queue. 
Squeue_insert_head (item, q_header) 


” - 
. BEGIN 
i BUILTIN 
. _ 
_ah_ = (q_header) : VECTOR (2, LONG]; 
. INSQUE ((item), _qgh_ (0]) 
i END 
i, 


Insert an element at the tail of a queue. 
Squeue_insert_tail (item, q_header) 
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i] - 
c BEGIN 
™ BUILTIN 
M 22 INSQUE; 
i. IND 
. ¢ _ah_ = (q_header) : VECTOR (2, LONG); 
I 3 INSQUE (Citem), ..qh_ (1)) 
_ +44 
M 2240 END 
$03 '¢ ee 
$08 i Remove the indicated element from a queue. The first parameter is the address of the element. The second 
2345 parameter is optional. 
46 i If supplied, it is the address of a longword in which to store the element removed from the queue or 0 if 
$sep ! no element was present in the queue. The value of the expression is TRUE is a element was removed from the 
248 ! queue and FALSE otherwise. 


NO 
a 
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queue and FALSE otherwise. 


If the second parameter is not supplied, the value of the expression is the address of the element removed 
from the queue or 0 if no element was present in the queue. 


H 49 ' 

; 0 ! If the second parameter is not supplied, the value of the expression is the address of the element removed 
; 1 } from the queue or 0 if no element was present in the queve. 

; " if 0 Squeue_remove (qelement, element) 

: Xs 25 BEGIN 

: M 2$ § 

| 28 0 me = (q_element) : VECTOR (2, LONG]; 

; # 0 BUILTIN 

3 . re REMQUE ; 

: 6¢ ZIF (RNULL (element)) 

; M 226 ZTHE 

; & 2264 0 LOCAL 

; 4 2265 0 TL : REF VECTOR C2, LONG]; 

: M 2268 6 TL = (element) : REF VECTOR (2, LONG]; 

; M 2269 O 2FI 

3; ® 2270 8 

3 M 2e71 IF (REMQUE (_qhead_, _T_)) 

: M 2272 O THE 

3 a 6, 8 BEGIN 

; : Le 8 queue was empty 

:™ 2277 0 iF (%NULL (element) 

188 8 a 

: M $550 0 ELSE 

; M2281 0 (_T_ = 0; FALSE) 

MB as 

; " 284 o BEGIN 

: M 286 0 IF (ZNULL (element)) 

im 5588 0 ont 

> M2289 0 ELSE ~ ~ 

Maa? ew 

> M 229 END 

; 238 6 - i, 

: 95 0 ' Remove an element from the head of a queve. The first parameter is the address of the queue header. The 
: $38 0 second parameter is optional. 

; 298 0 If supplied, it is the address of a Lepguaré in which to store the element removed from the queue or 0 if 
3 99 8 no element was present in the queue. The value of the expression is TRUE is a element “as removed from the 
; 0 

3 0 

$e 8 


' 
' 
i 
i 
$ 


queue_remove_head (q_header, element) 
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4 = 
M oF BEGIN 
i] 
M 230 BIND 
" _ah_ = (q_header) : VECTOR (2, LONG); 
M 251 ZIF (ZNULL (element)) 
Mm 231 ZTHEN 
: : $queue_remove (._qh_ (0]) 
- : $Squeue_remove (._qh_ [0], element) 
M 231 
M 231 END 
2 i, 


Remove an element from the tail of a queue. The first parameter is the address of the queue header. The 
' second parameter is optional. 


If supplied, it is the address of a longword in which to store the element removed from the queue or 0 if 
! no element was present in the queve. The value of the expression is TRUE is a element was removed from the 
! queue and FALSE otherwise. 


If the second parameter is not supplied, the value of the expression is the address of the element removed 
! from the queue or 0 if no element was present in the queue. 


™ 
$queue_remove_tail (q_header, element) 
BEGIN 


BIND 
-ah_ = (q_header) : VECTOR (2, LONG); 


ZIF (ZNULL (element)) 
ZTHEN 
$queue_remove (._qh_ [1]) 
ZELSE 
eft $queue_remove (._qh_ [1], element) 


END 
z, 


: Test a queue for emptiness. TRUE if the queue is empty, FALSE if the queue is not empty 


AIP rorononenononern) 


WN $0 ODONOVUSWN —OVOODVNOUS WN 0 0@ 


WAN AAW WANA NAAANANWA NANA 


BBBSBBSESBESETSIITS 
WINANS 
WWUuiisus 
—SODNOUEWN OOD NAUEWN OO OONOUM 


PIRI NDMIPINININININNUNININININININININIAPIPIPYPIPOPINININININYNIPINPIPUNINPIAINIPIDINPINININPINPUNININPINPIPYPNPD 


$queue_empty (q_header) 
BEGIN 


BIND 
agh_ = (q header) : VECTOR (2, LONG); 


_ah_ EQLA ._qgh_ [0] 


EN 
z; 


BBBBBESZIT 
SOOOSOSOOSOOOSOCOCOOCOCOOOSOSSO UG VQOOoooooooocdooCOoOOOoCoooCoOOoooooooooo 
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: Literal definitions: 


define Literals for BLISS true and false values 


LITERAL 
true = 
false = 6 


Define values of some ASCII characters 


LITERAL 
NUL = 0 ' null 
Lf 16, ! Line feed 
vt = 11, ' vertical tab 
fF 6 \¢° ' form fee 
CR =1 ' carriage return 
CTRLZ = 36, ' control 2 
ESC = 27 ' escape 
DEL = 127 i rubout 


Define the Radix-50 equivalents for FILE.BAD 
LITERA 


Sa Be Oe Be Be Oe Oe Se Oe Oe Se Be Oe Se Se Se Se Se Se Se Ge OHS) Se He Se Se Oe Se FH SH Se Be Se Se Se Be Oe Se Oe Se Oe Oe Se Se OH Se Oe Se Oe ee ee & ‘ ee tee 

s NO 
CTDOOCOCOGOOCCOCOOCOCOOOCO QOCOOCOCCOSOSSOSCOCCO COCO SCOOCOCOOOOOOCOOOOCOCOOOOOOOOoOO 

~" 

— 

aa 

" 

Cad 

@ 

> 

o 

oO 

—s 

— 

mn 

me 

rc 


89 R5SO_EMPTY = ZRADSO_11 ‘EMPTY ', ! Longword ‘EMPTY 
wor 

91 RSO"FILE = 2X '1F4026F4", i lonqword “FILE “ 

3 50_BAD = &xK ‘OCAC’, ! wor 

93 R5O-SYS = %X *7ABB' i word "SYS" 

95 : 

3 Linkage definitions: 

399 LINKAGE 
tot IRI) O ae ee dinthi woreeeec2.3.4.4.4.7,8,9.10.10) 
40¢ jsb_rOrir2 = JSB (REGISTER=0, REGISTER=1, REGIS Ree ire nip ah caer Mig ae PE. 
40 : NOPRESERVE(0,1,2) NOTUSED(3,4,5,6,7,8,9,10,11), 
404 jsb_r1 = JSB (REGISTER=1) 

5 : RVE(O,1) NOTUSED(2,3,4,5,6,7,8,9,10,11), 
ri eateind ecg hor yeegtsten=2) NOTUSED(3,4,5,6,7.8.9,10.11) 
408 isbrir2r3 = 8B (REGISTERS REGISTERS? REISER SIS no to “a. 
ret jsb.r2r3 = JSB (REGISTER: yheglstenss) PURE FELLAS, 
alg jsb_r3r4 = JSB (REGISTER=3, REGISTER=4) Re ee ee 
41 . : NoPne sEAvE(O 1 5 3,4) NOTUSED(S 6,7,8,9,10,11), 

414 jsb_get = JSB (REGISTER= REGISTERS REGISTER: j 

415 pee a CECA OPRE SERVE ile RATES ) NOTUSED(8,9,10,11), 
u = = 

<i? ~ : NOPRESEAVE (6,1 ,5-3,4,5,6,7.8,9,10) NOTUSED(11) 


——— $$$ —— 


— 
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the facility 


"50558 


: Run-time Library and other routines external to 
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EXTERNAL ROUTINE 

Li ¢\ parse ADDRESSING_MODE (GENERAL), ! Command parsing routine 
cli$dispatch +: ADDRESSING_MODE (GENERAL), ! Action routine dispatch 
cli$get_value : ADDRESSING _MODE (GENERAL), ! Entity value fetch 
¢} Seeresent : ADDRESSING_MODE (GENERAL), ! Entity presence boolean 
LibSfind_file : ADDRESSING_MODE (GENERAL), ! Wildcard ha processing 
LibSfree_vm : ADDRESSING MODE (GENERAL), ! Releases memo 

Lib$Sget_Tnput : ADDRESSING_MODE (GENERAL), ! Get a Line tron SYSSINPUT 
Lib$Sget_vm DDRESSING_MODE (GENERAL), ! Gets. memo ary 
s segeus output ADDRESSING_MODE (GENERAL), ! D seler se ine on SYSSOUTPUT 
ots$cvt_ti_ ADDRESSING_MODE (GENERAL), ! ASCII decimal to longword 
ots$cvt_to_l ADDRESSING_MODE (GENERAL), ! ASCII octal to longwor 
ots$cvt_tz_l ADDRESSING_MODE SEE NERAL) « : poy poqocve yaee o longword 
str$copy_dx ADDRESSING_MODE (GENER ae : copy string of any class 
strSfreeT dx ADDRESSING_MODE (GENERAL) ! Release dynamic string 


} An $RMSB describes an RMS file, the SDL block plus one RMS work area 


exchblk$s_rmsb = 


rmsb$k_length + fab$k_bln + rab$k_bln + nam$k_bln + (2*nam$c_maxrss), 


A $VOLB contains the structures for a volume, the SDL block plus one RMS work area 


exchblk$s_volb = volb$k_length + fab$Sk_bln + rab$k_bln + nam$k_bln + (2*nam$c_maxrss), 
The following don't need adjusting, but we want to keep all the EXCHBLK$S_ definitions in one place 


exchblk$s copy = copy$k_length, 
exchblk$s_dire = dire$k_length, 


exchblk$s_dos11 = dosliSk_ lengt 
oslictx = dosiTctx 


exchblk$s_d 


exchblk$s_ tb = filbSk_length 


exchblk$s_init 
exchblk$s_namb 


exchblk$s_moun = moun$k 


exchblk$s_rti1 
exchblk$s_rtll 


exchblk$s_ rtnam = 


= initSk 


k_Lengt 
= namb$k 


katength 
~tength 


= rtl1$k~ hengen 
ctx = rtlTcotxdk 


ar length, 
h. 


_length, 


rtnam$k_length 


! Size of 


the work 


area for the IN 


the work area for the COPY command 

the work area for the DIRECTORY command 
the DOS-11 specific extension to the volb 

the DOS-11 file context block 

is 3 structure waren describes — open file 
e wor 

AMB is a structure which stores a fully parsed file name 

area for the MOUNT comman 

the RT-11 specific extension to the volb 

the RT-11 file context block 

the work area for the DIRECTORY command 


IT comma 


' Define the Lengths of control blocks here - Many of these need to be adjusted by system block sizes, so it 
can't be completely done in the SDL definition. 


LITERAL 
An SEXCG is the global environment for the facility, the SDL block plus two RMS work areas 
exchblk$s_excg = excg$k_length + 2*(fab$k_bln + rab$k_bln + nam$k_bln + (2*nam$c_maxrss)), 


; re 8 } Message codes defined in SRC$:EXCMSG.MSG 

3 47) EXTERNAL LITERAL 
ls 4? exch$_accessfail, 
13 47 exch$_badfilename, 
1; 2674 exch$_badlogic, 

: 475 exch$_badpad, 

; 47 exch$_binchksum, 

; 47 exch$_binrec fmt 

: 2678 exch$_blockcheck 

: 479 exch$_blockcheckO, 

3 4 8 exch$_carceled, 

; 481 exch$_closeerr, 

; 4 ¢ 0 exch$_closeforeign, 

3 483 0 exch$_copied, 

; 484 0 exch$_copyboot, 

3 485 exch$_copnewname, 

3 rt exch$_createvirt, 

: 4 exch$_deleted, 

; 488 0 exch$_deleteprev, 

; 489 : exch$_devonly, 

: 490 exch$_devnotsuit, 

: 491 0 exch$_dire_error, 

: 492 0 exch$_dismounted, 

; 4935 0 exch$_dos11_badlabel, 

: 494 0 exch$_dos11_blocksize, 

3 495 0 exch$_dos1!_ioerror, 

; 496 0 exch$_dos11_position, 

; 497 0 exch$_filenot found, 

3 498 8 exch$_filll_norec, 

5 499 exch$_ignore_dire, 

3 500 8 oxchd_iprore vers. 

3 501 exch$_illmtcopy, 

; 502 0 exch$_initialized, 

3 50 exch$_invrecfmt, 

; 504 exch$_invvol fmt, 

3 505 0 exch$_many_to_one, 

3 208 0 exch$_mounted, 

3 507 0 exch$_mounterror, 

3 508 0 exch$_mountvir, 

; 509 8 exch$_noalloc, 

3 510 exch$_nocarriage, 

; 511 0 exch$_nocopbad, 

3 512 8 exch$_nocopbaddel, 

3 515 exch$_nocopdup 

3 514 2 exch$_nocoploc 

; 515 exch$_nocopnodel, 

3 318 0 exch$_nocopprot, 

; 51 8 exch$_nocopsanmdev, 

: 518 exch$_nocopsysdel, 

3 519 8 onene nec eey ° 

; 520 exch$_nodellock, 

3 521 exch$_nodevice, 

; 5 § exch$_noremote, 

3 5 exche_norendey. 

3 524 exch$_norenexists, 

8 525 0 exch$_norenlock, 
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| 
SD 


failed to access volume ($GETDVI service failure) 

File name not valid for given volume 

Adds error number to shared message 

Improper /RECORD_FORMAT=PAD option 

Bad formatted binary record 

Bad formatted binary record 

Block check failed 

Block check failed because block address is 0 

Command canceled 

Error closing file 

Error closina foreign device 

Log message for copy command 

Log message for copy /boot command 

File copied with new name 

Error creating virtual volume 

Deleted copy of a file 

Deleted previous copy of a file : 

Device spec only, other parts of file name ignored 

Device is not suitable for EXCHANGE 

Error writing directory 

Device has been dismounted 

Invalid label found on dos11 tape 

Invalid block (>512 bytes) found on dos11 tape 

Error during 1/0 on dos11 tape 

Rewinding tape to find correct position 

Unable to locate file 

No /RECORD for files-11 

Ignoring directory specification 

Ignoring file version number 

Illegal magtape copy, input and output on same device 

Device has been initialized 

Record format not valid for volume type 

Volume format not valid for operation 

Multiple input files were given but only one output file 

Volume mounted (success) 

Error peeterates VMS $mount service 

Virtual volume mounted (success) 

/ALLOCATE ignored on tape output 

/CARRIAGE ignored on eyyeut 

Couldn't create, .BAD file with wildcarded names 

Couldn't create, have to delete .BAD file | 

Couldn't create, already created same name 
j 
| 
| 
| 


Couldn't create, volume is writelocked 

Couldn't create, file of same name and /NODELETE given  —s_ 
Couldn't create, file of same name protected against modification 
Illegal copy to same device 

Illegal copy of .SYS when existing .SYS present 

Unable to copy boot info 

File not deleted, volume locked 

Device spec missing 

Device spec cannot have node field 

Illegal rename to different device 

Not renamed, already exits 

Files not renamed, volume locked 


a _— 
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exch$_volume_full, 
exch$_waiterr, 


Cannot change size of virtual devices 
Volume has been mounted on VMS 

Volume is already mounted 

Output wetyne is full 


Error wa ing, ter RMS operation 


3 $ exch$_nosysact, ! No action on .SYS files : 
3 exch$_notcopied, ! File not copied : 
3 exch$_notcop_retry, ' File not copied, will retry ; 
; exch$_notdeleted, ! File not deleted ; 
3 0 1\ exch$_notimplement, ! Feature not yet implemented . 
: 1 exch$_notmounted, ! Device is not mounted on EXCHANGE ; 
3 § exch$_notsamedev, : neve and output not same device (copy /boot) . 
; exch$_notvallen, ' /REC=LEN requires FIXED : 
; exch$_novolumes, ! No volumes are mounted : 
; 5 exch$_openforeign, ' Open failed on a foreign volume ; 
3 exch$_openvirtual, ! Open failed on a virtual volume ° 
3 exch$_opnotperdos, ! Operation not permitted on DOS-11 volume : 
; 8 exch$_opnotperf11 ! Operation not permitted on Files-11 volume : 
3 9 \ exch$_opnotperrt11, ! Operation not permitted on RT-11 volume (not yet needed) ° 
3 re '\ exch$_opnotperrtmt, ! Operation not permitted on RT-11 magtape volume ; 
3 41 exch$_parseerr, ' Bad file parameter syntax ; 
; 206 exch$_partcopied, ! File partially copied : 
3 54 exch$_readcheck, ! Error detected during read check : 
3 544 exch$_readcheckrec, ! Error detected during read check was recovered : 
; 545 exch$_readerrrec, ! Error detected during read was recovered ; 
3 2 exch$_recover ! Directory recovery message ; 
: 4 exch$_rectoobig, ! Bad formatted binary record : 
3 548 exch$_renamed, ! File renamed log message ‘ 
: $889 excnscrtii-padtilec i Bad block file created 
; exch$_rtil_ba e ! Ba oc e create : 
; 551 2 exch$_rtl1_bigbadfile, ! Bad block file contains some good blocks : 
3 226 0 exch$_rtl1_dirsize, ! Device size disagrees with directory size ; 
; 327 0 orche_rtt} .orrieck.  RT=11 directory error : 
: 2555 0 exchSortl1-noend, i steal dieseters orve? ; 
3 228 0 exch$-rt!t_overtlow, hae Be girectery error : 
3 exch$_rti1_stbloc ! RT- rectory error : 
: 558 8 exch$_rt11~toomanyblk, ! RT-11 directory error 3 
: $860 0 cucheorsticunents | Bt-ll director? srrer 
3 561 0 exch$_rtouteof, ! End of file on output file : 
: 206 4 exch$_rtprotect, ' File protected against modification $ 
; 56 exch$_stmrecfmt ' Bad stream record format : 
; 5 0 exch$_stnotavail ' Start block not available : 
3 0 exch$_strtnomulti, ' Can't say /START with multiple input files : 
3 0 exch$_toomanycol, ! Too — columns requested : 
; 0 exch$_trace, ! Header for a status trace : 
3 0 exch$_ typed. ' Log message for type command é 
3 exch$_virtnochange, : 
: i ; 
° i : 
r! i 3 
: i : 
: i 

; i 

4 i 

i 
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exch$_writecache, hd modified Sirecsecy sognents 
7 exch$_writecheck, Error detected during write check 
7 exch$_writecheckrec, Error detected during write check was recovered 
7 exch$_writeerrrec, Error detected during write was recovered 
8 exch$_writelock Volume is write-locked 
80 e 
3 : Shared message definitions 


eee a = n 


| F 1 | 
16-Sep-1984 00:35:17 VAK=11 Bliss-32 v4.0-74 Page 21) 
18-8681 382 9 tats $25 $DUA28: LEXCHNG. SRC EXCL1I6.832;1 . ab) 
: P Sshr_msgdef 
; P tesn 248, local, | 
; P : (badlogic, warning), ! Using private message so can add error number 
3; ? (badvalue, warning), 
3; ? (closeout, warning), 
; P fconfqual. warning) 
: P 2589 Cinsvirmem, warning), | 
3? (openin, warning) 
; P 2591 (openout, warning), 
7 P 3 (readerr, warning), 
; P 259 (writeerr, warning) | 
3 536 ); | 
:P Sshr_msgde ! Message from CLI that syntax error occurred 
7 P 3 lass $, local, 7 . | 
3 ? 38 (syntax, severe) | 
; 2600 : | 
: vet Other symbols which need explicit declarations 
; £08 EXTERNAL LITERAL 
3 604 cli$_comma, ! Parameter ended with a comma 
; 605 cli$_concat, ! Parameter ended with a plus sign 
3 e's cli$_locneg, ! An explicit /NOqual for local qual 
3 607 0 cli$_locpres, ! An explicit /qual for local qual 
; 608 cli$_nocomd, ' CLI saw a blank Line and burped 
5 cli$_negated, ! An explicit /NOqual was given 
g 0 cli$_present, ! An explicit /qual was given 
; 1 0 cli$_facility; ! CLI facility code 
; j Storage external to all modules 
F 5 EXTERNAL 
: § exch$cld_table : ADDRESSING_MODE (LONG_RELATIVE) ! Command table for CLISDCL_PARSE 
; : ! External data - defined in EXCHSMAIN module 
; 1 EXTERNAL 
3 § exch$oa.dyn_ste template : edese block ADDRESSING MODE (LONG RELATIVE), ! An initialized, null dynamic strin 
: 2 exch$a_gbl : REF BLOCK C,BYTE] ADDRESSING _MODE (CONG_RELATIVE) ! The pointer to the known world 
; 5 . 
: 6 0 ! END ! End of module EXCLIB 
3 P ! ELUDOM 
3 Library Statistics 
: eeccesoce Symbols ecececece Pages Processing 
F File Total Loaded Percent Mapped Time 
5 _$255$DUA28:(SYSLIBILIB.L32;1 18619 33 0 1000 00:01.8 | 
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